home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / PRINTING.SWG / 0008_PRINTER2.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  63 lines
  1. {
  2. I am looking For something like in BASIC where you could ON ERRO GOSUB
  3. and anytime there was an error the Program re-routed..
  4.  
  5. It Sounds like you're after two things; a method of checking your Printer
  6. and a means of trapping runtime errors.
  7. }
  8. Function PrinterReport:Byte;
  9. { This Function requires the Dos Unit. Returned values mean the following -
  10.   0 = Printer is okay
  11.   1 = Printer is out of paper
  12.   2 = Printer is offline
  13.   3 = Printer is busy
  14.   4 = God knows what's wrong With the Printer but I'd get an engineer out.}
  15. Var
  16.   Regs : Registers;
  17. begin
  18.   With Regs do
  19.   begin
  20.     Ah := 2;
  21.     Dx := LPTport;
  22.     intr($17,Regs);
  23.     if (Ah and $B8) = $90 then PrinterReport := 0
  24.     else if (Ah and $20) = $20 then PrinterReport := 1
  25.     else if (Ah and $10) = $00 then PrinterReport := 2
  26.     else if (Ah and $80) = $00 then PrinterReport := 3
  27.     else if (Ah and $08) = $08 then PrinterReport := 4;
  28.     end;
  29. end; { of Function }
  30.  
  31. {
  32. As For trapping runtime errors, all you have to do is replace the
  33. standard Exit Procedure With your own. For example...
  34. }
  35.  
  36. Program JohnMajorGoosedTheCook;
  37. Var
  38.   SavedExitPoint : Pointer; { This holds the old Exit proc value }
  39.   Number         : Integer;
  40.  
  41. {$F+}
  42. Procedure MyExitProc;
  43. {$F-}
  44. begin
  45.   if errorAddr <> NIL then { if you got a runtime error... }
  46.   begin
  47.     Writeln ('The Programmer got it wrong again. There has been an');
  48.     Writeln ('error at ',seg(errorAddr^), ':', ofs(errorAddr^));
  49.     Writeln ('with an Exit code of ',exitCode);
  50.     Writeln ('Please call him on 123-4567 and give him dogs abuse.');
  51.     errorAddr := NIL; { which cancels the runtime error address...}
  52.     ExitCode := 0;    { which cancels the runtime error code }
  53.   end;
  54.   Exitproc := SavedExitPoint; { restore the old Exit Procedure...}
  55. end; { of Procedure }
  56.  
  57. begin
  58.   SavedExitPoint := ExitProc;  { Save the old Exit Procedure...  }
  59.   ExitProc := @MyExitProc;     { ...and replace it With your own }
  60.   Number := 0;                 { Uh oh... }
  61.   Writeln (4 div Number);      { Oh dear...}
  62. end. { of PROGRAM }
  63.